perm filename PUB2.SAI[OK,TES] blob
sn#119650 filedate 1974-09-07 generic text, type T, neo UTF8
00100 BEGIN "PUB2"
00200 REQUIRE "VERSION" SOURCE!FILE;
00300 REQUIRE 6500 STRING!SPACE ;
00400 COMMENT The Document Compiler -- Pass Two ;
00500 COMMENT TES 6/11/74 added XGP Left Margin to: ;
00600 COMMENT PASS 1 OUTPUT FORMAT FOR EACH PAGE :
00700 Height Width XGPLeftMargin
00800 For each area:
00900 UpperLine NumCols NumLines
01000 For each column:
01100 LeftChar
01200 For each non-null line: LineNo SHORTM Index of PUInS.PUI line
01300 0
01400 -10
01500
01600 PASS 2 reads the output file name and the intermediate page file names from
01700 PUPSEQ.PUI, and the label table from PULABL.PUI. Then it reads
01800 each page from each page file, processes each line in each of
01900 its areas, and writes out a line printer image on the output file.
02000
02100 Each line is subject to three operations, in this order:
02200 (1) Substitute label values at each vertical tab.
02300 (2) Justify the line, if required, by inserting spaces at word breaks marked by altmodes.
02400 (3) Generate underlining and super/sub-scripting as indicated by rubouts.
02500
02600 ;
02700
02800 DEFINE THRU = "STEP 1 UNTIL", DOWN = "STEP -1 UNTIL",
02900 TES = "COMMENT", RKJ = "COMMENT", TVR = "COMMENT", PJ = "COMMENT",
03000 ie = "COMMENT", AWHILE = "WHILE TRUE",
03100 INP(BRKTBL) = "INPUT(SCHAN, BRKTBL)", INNUM = "WORDIN(ICHAN)",
03200 SCN(BRKTBL)="(IF FROMFILE THEN INPUT(SCHAN,BRKTBL) ELSE SCAN(OWL,BRKTBL,PAGEBRC))",
03300 SCNUM = "CVD(SCN(TO!ALTMODE!SKIP))",
03400 LPT = "1", TTY = "2", MIC = "3", XGP = "4",
03500 HORIZ="'40", VERTI="'41", CSIZE="'42", ULINE="'43", RSPCS="'44",
03600 LSPCS="'45", UDOTS="'46", RDOTS="'47", comment FR80 escape codes ;
03700 FULSTR(X) = "LENGTH(X)", NULSTR(X) = "(LENGTH(X)=0)",
03800 CR = "'15", LF = "'12", VT = "'13", FF = "'14", SP = "'40",
03900 RUBOUT = "'177", TB = "'11",
04000 ALTMODE = IFC TENEX THENC "'33" ELSEC
04100 IFC VERSION=SAILVER THENC "'175" ELSEC "'176" ENDC
04200 ENDC,
04300 TO!ALTMODE!SKIP = "1", TO!LF!APPD = "2",
04400 ONE!CHAR = "3", BREAKER = "4", TO!RUB!ALT!SKIP = "5",
04500 LOCAL!TABLE = "6",
04600 FIML = "256",
04700 ANS(A) = "(S = ""A"" OR S = ""A"" + '40)";
04800 DEFINE COMMENT FOR XGP;
04900 USEA="('177&'14)", USEB="('177&'15)", VSB="('177&'20)",
05000 XTAB="('177&'30)",
05100 XGPNUM(N)="((N LSH -7) & N)";
05200 DEFINE ESCAPE1="('177&'1)", ESCAPE2="('177&'2)";
05300 DEFINE CTLF="6", CTLE="5", CTLT="'24", CTLQ="'21";
05400
05410 IFC VERSION = SAILVER THENC DEFINE RPGEXT = """.RPG""" ; ENDC
05420
05500 PJ 5/28/74 ; DEFINE
05600 PUIEXT = IFC VERSION=ITSVER THENC """ PUI""" ELSEC """.PUI""" ENDC,
05700 OCTEXT = IFC VERSION=ITSVER THENC """ OCT""" ELSEC """.OCT""" ENDC,
05800 TXTEXT = IFC VERSION=ITSVER THENC """ TXT""" ELSEC """.TXT""" ENDC;
05900
06000 TES 1/7/74 ; DEFINE CTLC="3", CTLH="'10", CTLR="'22", CTLU="'25", CTLS="'23" ;
06100 INTEGER IML, IMC, comment, no. of lines and chars per page image ;
06200 DEBUG, DEVICE, SEQCHAN, SEQBRC, SEQEOF, comment PUPSEQ.PUI info ;
06300 LFTMAR, comment XGP left margin (for tabs) ;
06400 INTRA, comment TES 6/11/74 PARC XGP Intra-line spacing (normally 3) ;
06500 LISTCHAN, comment output file ;
06600 BAR, TES underlining character (or 0 if OFF) 10/22/73;
06700 PAGEHIGH, PAGEWIDE, comment IML and IMC for latest page ;
06800 I, J, K, L, M, N, DUMMY, comment general-purpose ;
06900 LABCHAN, LABBRC, LABEOF, comment PULABL.PUI info ;
07000 NL, comment LABTAB upper bound ; PAGECT, comment counts pages ;
07100 TABLE, comment LABTAB first subscript -- selects Pass 1 NUMBER vs ITBL ;
07200 ICHAN, SCHAN, FROMFILE, PAGEBRC, PAGEEOF, comment PUIn[S].PUI info ;
07300 TOPLINE, NCOLS, NLINES, comment Area info ;
07400 COL, LEFTCH, comment Column info ;
07500 SLIDETOP, comment top of ∞ stacks such as SLIDESG ;
07600 NCSIZE,CCSIZE, NHORIZ,CHORIZ, NVERTI,CVERTI, comment microfilm normal/current settings ;
07700 NEEDCR, comment, assures CR before every LF for Stanford LPT ;
07800 CHARW, LINENO, SHORTM, SH, BRKS, FSTBRK, CHRS, FSTCHRS, SG, NOTFST, comment, Line info ;
07900 TERM, TERMX, LINE, UNDERLINE, CHAR, F, G, LAST, LASL, AVAIL ; comment, Justify info ;
08000
08100 INTEGER SCRIPT, comment baseline adjustment ;
08200 THISFONT, comment PARC font number for scripts;
08300 SCRLVL, comment baseline level ;
08400 BASELINE ; comment useful? for underscore at stanford ;
08500
08600 INTEGER TLFTMAR ; TVR temporary left margin in XGP pts;
08700 BOOLEAN DOPASS3; RKJ: 1-4-74 flag for PASS 3 at CMU;
08800 BOOLEAN XCRIBL ; RKJ: 1-9-74 contains "DEVICE=XGP" ;
08900
09000 INTEGER FLUSHING, FSIZE; comment kludges for XGP ;
09100 EXTERNAL INTEGER RPGSW ;
09200
09300 IFC VERSION=PARCVER AND NOT TENEX THENC
09400 SIMPLE PROCEDURE FOOBAZ;
09500 START!CODE "FOOBAZ"
09600 LABEL EVEC,GO,STRT,REEN;
09700 EVEC: JRST STRT;
09800 JRST REEN;
09900 HRRZ 1,'120;
10000 JRST 1(1);
10100 STRT: HRRZ 1,'120;
10200 JRST (1);
10300 REEN: HRRZ 1,'124;
10400 JRST (1);
10500 GO: MOVEI 1,'400000;
10600 MOVEI 2,EVEC;
10700 HRLI 2,3;
10800 '104000000204;
10900 '104000000170;
11000 END "FOOBAZ";
11100 ENDC
00100 STRING TMPFILE, LISTFILE, PAGEFILE, IFILE, SFILE, S,
00200 OWL, SS, T, ENDLINE, RESTARTLINE, ENDPAGE, DELINT, CRLF, JOBNO ;
00300 TES 1/7/74 ; STRING CMDFILE ;
00400 TES 3/20/74 ; STRING IFILENAME ; INTEGER IFICHAN ;
00500
00600
00700 REAL RATIO ;
00800
00900 INTEGER ARRAY CHARTBL[0:127], XFILL,XINF,SLIDESG,RB,LBD[1:5] ;
01000
01100 STRING ARRAY LBF[1:5] ;
01200
01300 INTEGER SIMPLE PROCEDURE READIN(STRING FILENAME; BOOLEAN BINARY ; REFERENCE INTEGER BRC, EOF) ;
01400 BEGIN "READIN"
01500 INTEGER CH ;
01600 CH ← GETCHAN ; EOF ← 0 ; OPEN(CH, "DSK", IF BINARY THEN 8 ELSE 0,2,0,150, BRC, EOF) ;
01700 LOOKUP(CH, FILENAME, 0) ; RETURN(CH) ;
01800 END "READIN" ;
01900
02000 INTEGER SIMPLE PROCEDURE WRITEON(STRING FILENAME) ;
02100 IFC TENEX THENC
02200 OPENFILE(FILENAME, "WC") ;
02300 ELSEC
02400 BEGIN "WRITEON"
02500 INTEGER CH ;
02600 CH ← GETCHAN ; OPEN(CH, "DSK", 0,0,2,0, 0, 0) ;
02710 AWHILE DO RKJ: 23-JUL-74 - CHECK FOR ENTER FAILURE ;
02720 BEGIN
02730 ENTER(CH, FILENAME, DUMMY←0);
02740 IF NOT DUMMY THEN DONE;
02750 OUTSTR("Cannot ENTER """ & FILENAME & """ Write file: ");
02760 FILENAME←INCHWL;
02770 END;
02780 RETURN(CH);
02800 END "WRITEON" ;
02900 ENDC
03000
03100 SIMPLE PROCEDURE WARN(STRING MESSG) ; OUTSTR(MESSG&CR&LF) ;
03200
03300 SIMPLE PROCEDURE IMPOSSIBLE(STRING HOW) ; WARN("Impossible case index for "&HOW) ;
03400 STRING SIMPLE PROCEDURE MICROFILM(INTEGER OP, ARG) ;
03500 RETURN('177 & OP & (IF OP≤'42 THEN (ARG DIV 128)&(ARG MOD 128) ELSE ARG)) ;
03600 STRING SIMPLE PROCEDURE SETSIZE(INTEGER N) ; RETURN(MICROFILM(CSIZE, CCSIZE ← N)) ;
03700 STRING SIMPLE PROCEDURE SETHORIZ(INTEGER N) ; RETURN(MICROFILM(HORIZ, CHORIZ ← N)) ;
03800 STRING SIMPLE PROCEDURE SETVERTI(INTEGER N) ; RETURN(MICROFILM(VERTI, CVERTI ← N)) ;
03900 STRING SIMPLE PROCEDURE DOULINE(INTEGER N) ; RETURN(MICROFILM(ULINE, N)) ;
04000 STRING SIMPLE PROCEDURE DORSPCS(INTEGER N) ; RETURN(MICROFILM(RSPCS, N)) ;
04100 STRING SIMPLE PROCEDURE DOLSPCS(INTEGER N) ; RETURN(MICROFILM(LSPCS, N)) ;
04200 STRING SIMPLE PROCEDURE DOUDOTS(INTEGER N) ; RETURN(MICROFILM(UDOTS, N)) ;
04300 STRING SIMPLE PROCEDURE DORDOTS(INTEGER N) ; RETURN(MICROFILM(RDOTS, N)) ;
04400
04500 RECURSIVE STRING PROCEDURE VARBLANK(INTEGER N);
04600 BEGIN "VARBLANK"
04700 IFC VERSION=CMUVER THENC
04800 IF N ≤ 0 THEN RETURN(NULL) ELSE
04900 IF N ≥ 128 THEN RETURN(VSB & 127 & VARBLANK(N-127)) ELSE
05000 RETURN(VSB&N)
05100 ELSEC IFC VERSION=SAILVER OR VERSION=ITSVER THENC
05200 IF N ≤ 0 THEN RETURN(NULL) ELSE
05300 IF N ≥ 64 THEN RETURN(ESCAPE2 & 63 & VARBLANK(N-63)) ELSE
05400 RETURN(ESCAPE2&N)
05500 ELSEC IFC VERSION=PARCVER THENC
05600 RETURN(CTLE&CVS(N)&".")
05700 ENDC ENDC ENDC;
05800 END "VARBLANK";
05900
06000 PRELOAD!WITH "", " ", " ", " ", " ", " ", " ",
06100 " ", " ", " ", " " ;
06200 SAFE STRING ARRAY SPSARR[0:10] ;
06300
06400 INTERNAL STRING SIMPLE PROCEDURE SPS(INTEGER N) ; IF N≤10 THEN RETURN(SPSARR[N MAX 0])
06500 ELSE IF DEVICE=MIC THEN RETURN(DORSPCS(N))
06600 ELSE BEGIN
06700 STRING S ; INTEGER I ;
06800 S ← SPSARR[10] ;
06900 FOR I ← 11 THRU N DO S ← S & SP ;
07000 RETURN(S) ;
07100 END ;
07200
07300 IFC TENEX THENC
07400 STRING PROCEDURE SCANTO(STRING BRKS; REFERENCE STRING SCANNEE; BOOLEAN INCLUDE) ;
07500 BEGIN
07600 INTEGER DUMMY ;
07700 SETBREAK(LOCAL!TABLE, BRKS, NULL, IF INCLUDE THEN "IA" ELSE "IR") ;
07800 RETURN(SCAN(SCANNEE, LOCAL!TABLE, DUMMY)) ;
07900 END ;
08000 ENDC
08100
08200 IFC VERSION=CMUVER THENC RKJ: 29-AUG-74;
08300
08400 INTEGER SIMPLE PROCEDURE INDEX2(STRING A,B);
08500 comment returns the location of the first occurance of
08600 the string B in A, 0 if none;
08700 BEGIN "INDEX2"
08800 INTEGER LA, LB;
08900 IF (LB←LENGTH(B))=0 THEN RETURN(1);
09000 IF (LA←LENGTH(A)-LB+1)<0 THEN RETURN(0);
09100 START!CODE
09200 LABEL L1, L2, OUTT, NEXT;
09300 MOVE 2,A; MOVN 1,LA; ILDB 0,B; SOS 0,LB;
09400 L1: ILDB 3,2; CAME 3,0; NEXT: AOJL 1,L1;
09500 JUMPE 1,OUTT;
09600 MOVE 4,2; MOVE 5,B; MOVE 6,LB;
09700 L2: ILDB 7,4; ILDB '10,5; CAME 7,'10; JRST NEXT; SOJG 6,L2;
09800 ADD 1,LA; AOJ 1,0;
09900 OUTT:
10000 END;
10100 END "INDEX2";
10200
10300 SIMPLE STRING PROCEDURE FIXUP(STRING S);
10400 BEGIN "FIXUP"
10500 INTEGER ALOC,BLOC;
10600 IF (ALOC←INDEX2(S,USEA))=1 THEN RETURN(S);
10700 IF (BLOC←INDEX2(S,USEB))=1 THEN RETURN(S);
10800 IF ALOC=0 THEN ALOC←BLOC;
10900 IF BLOC=0 THEN BLOC←ALOC;
11000 ALOC←ALOC MIN BLOC;
11100 RETURN(S[ALOC FOR 2]&S[1 TO ALOC-1]&S[ALOC+2 TO ∞]);
11200 END "FIXUP";
11300 ELSEC
11400 DEFINE FIXUP(X)="X";
11500 ENDC
00100 COMMENT I N I T I A L I Z E ;
00200 IFC VERSION=PARCVER THENC
00300 DUMMY←CVSIX("PUB2 ");
00400 START!CODE
00500 MOVE 1,DUMMY;
00600 '104000000210;
00700 END;
00800 ENDC
00900
01000 SCRIPT ← 10;
01100 IFC TENEX THENC JOBNO ← CVS(GJINF(DUMMY, DUMMY, DUMMY)) ; ENDC TES 10/25/73 ;
01200
01300 IFC VERSION=PARCVER THENC IML←65; IMC←72; ENDC
01400 IFC VERSION=SAILVER THENC IML←53; IMC←69; ENDC
01500 IFC VERSION=ITSVER THENC IML←55; IMC←69; ENDC PJ 5/28/74 ;
01600 IFC VERSION=CMUVER THENC IML←55; IMC←69; ENDC
01700 PAGEHIGH ← PAGEWIDE ← PAGECT ← 0 ; CRLF ← CR & LF ;
01800 SETBREAK(ONE!CHAR, NULL, NULL, "XA") ;
01900 SETBREAK(TO!ALTMODE!SKIP, ALTMODE, NULL, "IS") ;
02000 SETBREAK(TO!LF!APPD, LF, NULL, "IA") ;
02100 SETBREAK(BREAKER, RUBOUT&VT&ALTMODE&CR&LF, NULL, "IS") ;
02200 SETBREAK(TO!RUB!ALT!SKIP, RUBOUT&ALTMODE, NULL, "IS") ;
02300 IFC TENEX THENC
02400 IF RPGSW THEN
02500 BEGIN
02600 IFICHAN ← READIN(JOBNO & ".PASS2", FALSE, DUMMY, DUMMY) ;
02700 IFILENAME ← INPUT(IFICHAN, TO!ALTMODE!SKIP) ;
02800 RELEASE(IFICHAN) ; TES 6/11/74 ;
02900 END
03000 ELSE BEGIN TES 6/11/74 REVISED ;
03100 OUTSTR("MANUSCRIPT: ") ;
03200 WHILE -1 = (J ←
03300 GTJFNL(NULL, '162000000000, '100000101,
03400 NULL, NULL, NULL, "PUB", NULL, NULL, NULL)) DO
03500 OUTSTR(" ?" & CRLF & "MANUSCRIPT: ") ;
03600 IFILENAME ← JFNS(J, '1000000000) ;
03700 END ;
03800 ENDC
03900 OUTSTR("PASS TWO: ") ;
04000 SEQCHAN ← READIN(
04100 IFC TENEX THENC IFILENAME&".FILES" ELSEC "PUPSEQ"&PUIEXT ENDC,
04200 FALSE, SEQBRC, SEQEOF) ;
04300 TMPFILE ← INPUT(SEQCHAN, TO!ALTMODE!SKIP) ;
04400 LISTFILE ← INPUT(SEQCHAN, TO!ALTMODE!SKIP) ;
04500 DEBUG ← CVD(INPUT(SEQCHAN, TO!ALTMODE!SKIP)) ;
04600 DEVICE ← CVD(INPUT(SEQCHAN, TO!ALTMODE!SKIP)) ;
04700 DELINT ← INPUT(SEQCHAN, TO!ALTMODE!SKIP) ;
04800 IFC VERSION = PARCVER OR VERSION = SAILVER OR VERSION = ITSVER THENC TES 1/7/74 ;
04900 IF DEVICE=XGP THEN
04950 BEGIN CMDFILE ← NULL ;
04975 DO CMDFILE ← CMDFILE & INPUT(SEQCHAN, TO!ALTMODE!SKIP) UNTIL SEQBRC=ALTMODE ;
04981 END ;
04987 ENDC ;
05000 BAR ← INPUT(SEQCHAN, TO!ALTMODE!SKIP)[1 FOR 1] ;
05100 IF BAR = SP THEN BAR ← 0 ; TES 10/22/73 ;
05200 CHARW ← CVD(INPUT(SEQCHAN, TO!ALTMODE!SKIP));
05300 LFTMAR←CVD(INPUT(SEQCHAN, TO!ALTMODE!SKIP));
05400 INTRA←CVD(INPUT(SEQCHAN, TO!ALTMODE!SKIP)); TES 6/11/74 ;
05500 BASELINE←CVD(INPUT(SEQCHAN, TO!ALTMODE!SKIP)); BASELINE←BASELINE+(BASELINE DIV 4);
05600 DOPASS3←CVD(INPUT(SEQCHAN, TO!ALTMODE!SKIP)); RKJ: 1-4-74;
05700 XCRIBL ← DEVICE=XGP ; RKJ: 1-9-74 got tired of writing conditional ; PJ 5/29/74 moved ;
05800 IF ¬RPGSW AND NOT XCRIBL THEN COMMENT STARTED BY ".R PUB2" ;
05900 DO BEGIN
06000 OUTSTR("OUTPUT DEVICE (LPT, TTY or MIC): ") ;
06100 S ← INCHWL ;
06200 DEVICE ← IF ANS(L) THEN LPT ELSE IF ANS(T) THEN TTY ELSE
06300 IF ANS(M) THEN MIC ELSE IF ANS(X) THEN XGP ELSE 0;
06400 END
06500 UNTIL DEVICE ;
06600 IF ¬RPGSW AND DEBUG THEN
06700 IF DEVICE = MIC THEN DEBUG ← 0
06800 ELSE DO BEGIN
06900 OUTSTR("Debug info in right margin? (Y or N) = ") ;
07000 S ← INCHWL ;
07100 DEBUG ← IF ANS(Y) THEN -1 ELSE IF ANS(N) THEN 0 ELSE 100 ;
07200 END
07300 UNTIL DEBUG < 100 ;
07400 ENDLINE ← LF ; ENDPAGE ← FF ;
07500 RESTARTLINE ←
07600 IFC PARCVER THENC IF XCRIBL THEN CTLT&"0." ELSE CR
07700 ELSEC CR ENDC ; TES 11/1/73 ;
07800 CASE DEVICE-1 OF
07900 BEGIN "DEV"
08000 comment 1...LPT ; LISTCHAN ← WRITEON(LISTFILE) ;
08100 comment 2...TTY ; LISTCHAN ← WRITEON(LISTFILE) ;
08200 comment 3...MIC ; BEGIN IML ← IMC ← 1 ; LISTCHAN ← WRITEON(TMPFILE) ;
08300 IF DEBUG THEN BEGIN WARN("Won't put Debug info on Microfilm") ;
08400 DEBUG ← FALSE ; END END ;
08500 COMMENT 4...XGP ; LISTCHAN ← WRITEON(LISTFILE)
08600 END "DEV" ;
08700 IFC TENEX THENC LISTFILE ← JFNS(LISTCHAN, 0) ; ENDC
08800 OUTSTR(LISTFILE) ;
08900 J ← 0 ; FOR K ← RUBOUT, ALTMODE, VT, CR, LF DO CHARTBL[K] ← J ← J + 1 ;
09000 LABCHAN ← READIN(
09100 IFC TENEX THENC IFILENAME&".LABELS" ELSEC "PULABL"&PUIEXT ENDC,
09200 FALSE, LABBRC, LABEOF) ;
09300 NL ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ;
09400 LASL ← 1000 ; comment, last physical line occupied on the page ;
09500 S←INPUT(SEQCHAN,TO!LF!APPD); comment get to right place ;
09600 TES 1/7/74 ADDED : TES 6/11/74 WITH INTRA:;
09700 IFC VERSION = PARCVER THENC
09800 IF XCRIBL THEN OUT(LISTCHAN,
09900 (RUBOUT&CTLC) & CMDFILE &
10000 ("K EFHJLMQRSTU" & CR & "I " & CVS(INTRA) &
10050 CR & "M 0" & CR & "W 1600" & CR & "E" & CR)) ;
10100 COMMENT
10200 CTLC Initiallize switches (used as RUBOUT CTLC)
10300 CTLE Variable blank
10400 CTLF Font change
10500 CTLH Overstrike
10600 CTLJ=LF Line Feed
10700 CTLL=FF Form Feed
10800 CTLM=CR Carriage Return
10900 CTLQ Quote control character
11000 CTLR Return to baseline from ript
11100 CTLS Subscript
11200 CTLT Tab
11300 CTLU Superscript
11400 RUBOUT Treat as control character (inverse CTLQ)
11500 ;
11600 ENDC
11700
11800 IFC VERSION = SAILVER THENC
11900 IF XCRIBL THEN OUT(LISTCHAN, "/LMAR=0"&CMDFILE&CRLF&FF) ;
12000 ENDC
13000 IFC VERSION=ITSVER THENC PJ 8/24/74 ;
13100 IF XCRIBL THEN OUT(LISTCHAN,";LFTMAR 0"&CRLF&
13200 ";VSP "&CVS(INTRA)&CRLF&
13300 ";SKIP 1"&CRLF&
13400 CMDFILE&CRLF&FF);
13500 ENDC
00100 BEGIN "INNER BLOCK"
00200
00300 STRING ARRAY LABTAB[0:1, 0:NL], OWLS[0:FIML-1] ;
00400
00500 AWHILE DO
00600 BEGIN "LABEL"
00700 TABLE ← CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP)) ; IF LABEOF THEN DONE ;
00800 LABTAB[TABLE, CVD(INPUT(LABCHAN, TO!ALTMODE!SKIP))] ←
00900 INPUT(LABCHAN, TO!ALTMODE!SKIP) &
01000 (IF XCRIBL THEN
01100 (ALTMODE & INPUT(LABCHAN, TO!ALTMODE!SKIP))
01200 ELSE NULL);
01300 END "LABEL" ;
01400
01500 RELEASE(LABCHAN);
01600
01700 COMMENT G O ! ;
01800 DO comment, This loop is re-entered only if page image grows ;
01900 BEGIN "SIZE"
02000 SAFE STRING ARRAY IMG[1:IML+IML], SEG[0:IMC+IMC], SRCREF[1:IML] ;
02100 SAFE INTEGER ARRAY LINK,FAKE,LASC[1:IML+IML] ;
02200 LABEL CONTINUE ;
02300
02400 INTEGER SIMPLE PROCEDURE APPD(STRING S) ;
02500 BEGIN "APPD"
02600 INTEGER HAD, EXTRA, SPACES, F ; STRING T, SS ;
02700 L ← LINE ; EXTRA ← LENGTH(S) ;
02800 IF XCRIBL THEN
02900 BEGIN TES 11/13/73 FOR MULTI-COLUMNS ;
03000 IF CHAR < (HAD ← LASC[L]) THEN
03100 BEGIN
03200 FAKE[L] ← FAKE[L] + HAD - CHAR ;
03300 HAD ← LASC[L] ← CHAR ;
03400 END
03500 END
03600 ELSE
03700 WHILE CHAR < (HAD ← LASC[L]) DO IF (F←LINK[L]) THEN L ← F ELSE
03800 IF (LINK[L] ← AVAIL←AVAIL+1) > IML+IML THEN WARN("TOO MUCH FOR 1 PAGE: " & S)
03900 ELSE L ← AVAIL ;
04000 T ← IMG[L] ; SPACES ← CHAR - HAD ; HAD ← HAD + FAKE[L] ;
04100 IF LENGTH(T) < HAD+SPACES+EXTRA THEN BEGIN comment no room -- must use concatenate ;
04200 SS ← SPS(SPACES) ; IF DEVICE=MIC THEN FAKE[L] ← FAKE[L] + LENGTH(SS) - SPACES ;
04300 IMG[L] ← IF HAD THEN T[1 TO HAD]&SS&S ELSE (0&SS&S)[2 TO ∞] END
04400 ELSE BEGIN comment there's room in old string -- IDPB into it.;
04500 SS ← T[HAD + 1 FOR 1] ; comment byte pointer to IDPB place ;
04600 START!CODE "APPEND" LABEL LOOP1, LOOP2 ;
04700 MOVE 1, SS ; MOVE 2, S ; MOVE 3, EXTRA ;
04800 MOVE 4, SPACES ; JUMPE 4, LOOP2 ; MOVEI 5, '40 ; LOOP1: IDPB 5,1 ; SOJG 4,LOOP1 ;
04900 LOOP2: ILDB 5, 2 ; IDPB 5, 1 ; SOJG 3, LOOP2 ;
05000 END "APPEND" ;
05100 END ;
05200 RETURN(LASC[L] ← CHAR + EXTRA) ;
05300 END "APPD" ;
05400
05500 SIMPLE PROCEDURE CTRL(STRING S) ;
05600 BEGIN "CTRL"
05700 CHAR ← APPD(S) - LENGTH(S) ;
05800 LASC[L] ← CHAR ;
05900 FAKE[L] ← FAKE[L] + LENGTH(S) ;
06000 END "CTRL" ;
00100 SIMPLE PROCEDURE UNDERSCORE(INTEGER RIGHTCHAR) ;
00200 BEGIN "UNDERSCORE"
00300 INTEGER NUMCHARS, DESCEND, SAVEHORIZ ;
00400 NUMCHARS ← RIGHTCHAR - UNDERLINE ;
00500 IF NUMCHARS > 0 THEN
00600 BEGIN
00700 SAVEHORIZ ← CHORIZ ;
00800 DESCEND ← CCSIZE DIV 4 ;
00900 CTRL( DOLSPCS(CHAR-UNDERLINE) & DOUDOTS(-DESCEND) & DOULINE(NUMCHARS-1) &
01000 SETHORIZ(CCSIZE) & DOULINE(1) & DOLSPCS(1) & SETHORIZ(SAVEHORIZ) &
01100 DOUDOTS(DESCEND) & DORSPCS(CHAR - RIGHTCHAR + 1) ) ;
01200 UNDERLINE ← RIGHTCHAR ;
01300 END ;
01400 END "UNDERSCORE" ;
01500
01600 SIMPLE PROCEDURE CHANGESPACING ;
01700 IF (N←CHRS-CHAR-1)>0 ∧ (K←(J←N*CHORIZ+SHORTM)/N MIN 511)≠CHORIZ THEN
01800 BEGIN "CHANGESPACING"
01900 IF UNDERLINE≥0 THEN UNDERSCORE(CHAR) ;
02000 SHORTM ← J - K*N ;
02100 IF NOTFST ∧ (UNDERLINE<0 ∨ SHORTM<0) THEN
02200 BEGIN DORDOTS(SHORTM) ; SHORTM ← 0 END ;
02300 CTRL(SETHORIZ(K)) ; NOTFST ← TRUE ;
02400 END "CHANGESPACING" ;
02500
02600 SIMPLE PROCEDURE FONTSELECT(INTEGER WHICH);
02700 BEGIN "FONTSELECT"
02800 IF (WHICH←WHICH-"0")>9 THEN WHICH←WHICH-("A"-"0"-10);
02900 IFC VERSION=CMUVER THENC
03000 WHICH←WHICH MOD 9; COMMENT MAKE 1,A 2,B EQUIVALENT;
03100 IF WHICH=1 THEN CTRL(USEA) ELSE
03200 IF WHICH=2 THEN CTRL(USEB) ELSE
03300 WARN("Font ignored")
03400 ELSEC IFC VERSION=SAILVER OR VERSION=ITSVER PJ 5/28/74 ; THENC
03500 IF WHICH>16 THEN WARN("Font ignored") ELSE
03600 BEGIN
03700 CTRL(ESCAPE1&(WHICH-1));
03800 IF SCRLVL THEN CTRL(ESCAPE1&'43&SCRLVL);
03900 END;
04000 ELSEC IFC VERSION=PARCVER THENC
04100 IF WHICH>9 THEN WARN("Font ignored") ELSE
04200 CTRL(6&(THISFONT←WHICH+"0"))
04300 ENDC ENDC ENDC;
04400 END "FONTSELECT";
04500
04600 STRING SIMPLE PROCEDURE XTABSTR(INTEGER N); RKJ: NEW 1-4-74;
04700 BEGIN "XTABSTR"
04800 IFC VERSION=CMUVER THENC RETURN(XTAB&XGPNUM(N)) ENDC
04900 IFC VERSION=SAILVER OR VERSION=ITSVER PJ 5/28/74 ; THENC
05000 RETURN(ESCAPE1&'40&XGPNUM(N))
05100 ENDC
05200 IFC VERSION=PARCVER THEN
05300 RETURN(CTLT&CVS(N)&".")
05400 ENDC;
05500 END "XTABSTR";
05600
05700 SIMPLE PROCEDURE XGPTAB(INTEGER N); RKJ: NEW 1-4-74;
05800 CTRL(XTABSTR(N+TLFTMAR));
05900
06000
06100
06200 STRING PROCEDURE SCNBYCOUNT(INTEGER COUNT) ;
06300 BEGIN
06400 INTEGER I ; STRING S ;
06500 S ← NULL ;
06600 FOR I ← 1 THRU COUNT DO S ← S & SCN(ONE!CHAR) ;
06700 RETURN(S) ;
06800 END ;
06900
07000 SIMPLE STRING PROCEDURE UNMASH(STRING Q) ;
07100 BEGIN TES 8/14/74 PACK EXCESS-64 4-BIT BYTES INTO 7-BIT BYTES ;
07200 STRING S ; S ← NULL ;
07300 WHILE FULSTR(Q) DO S ← S & (((LOP(Q)-64)LSH 4) + (LOP(Q)-64)) ;
07400 RETURN(S) ;
07500 END ;
00100 SIMPLE PROCEDURE RIGHTBOUND ;
00200 BEGIN "RIGHTBOUND" COMMENT RIGHT BOUND OF ∞ ;
00300 INTEGER DEST, FILLIN, I ; STRING FILLER, OLBF ;
00400 INTEGER XF; STRING XTO ; TES 3/30/74;
00500 IF SLIDETOP < 1 THEN BEGIN IMPOSSIBLE("SLIDETOP1") ; SLIDETOP ← 1 END ;
00600 IF LBD[SLIDETOP] < -900 THEN COMMENT FLUSH RIGHT ;
00700 BEGIN
00800 IF XCRIBL THEN
00900 BEGIN
01000 XF←RB[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE);
01100 XTO ← "=" ;
01200 END ;
01300 FILLIN←RB[SLIDETOP]-CHRS;
01400 END
01500 ELSE COMMENT CENTER ;
01600 BEGIN
01700 IF XCRIBL THEN
01800 BEGIN
01900 XF ← (RB[SLIDETOP]-LBD[SLIDETOP]-(XFILL[SLIDETOP]+FSIZE)) DIV 2;
02000 XTO ← "+" ;
02100 END ;
02200 FILLIN ← ((RB[SLIDETOP]-CHRS) DIV 2) MAX 0;
02300 END;
02400 DEST ← CHRS + FILLIN ; OLBF ← LBF[SLIDETOP] ;
02500 IF FULSTR(OLBF) THEN
02600 IF XCRIBL THEN
02700 BEGIN "XGPINFINITY"
02800 FILLER ← NULL ;
02900 FOR I ← 1 THRU XINF[SLIDETOP] DO FILLER ← FILLER & OLBF ;
03000 SEG[I ← SLIDESG[SLIDETOP]] ← FILLER ;
03100 SEG[I + 1] ← RUBOUT & XTO & CVS(XF) ;
03200 END "XGPINFINITY"
03300 ELSE
03400 BEGIN "NON-BLANKS"
03500 FILLER ← NULL ;
03600 WHILE CHRS < DEST DO
03700 BEGIN
03800 FILLER ← FILLER & OLBF ;
03900 CHRS ← CHRS + LENGTH(OLBF) ;
04000 END ;
04100 IF CHRS > DEST THEN FILLER ← FILLER[1 TO ∞-(CHRS-DEST)] ;
04200 SEG[SLIDESG[SLIDETOP]] ← FILLER ;
04300 END "NON-BLANKS"
04400 ELSE SEG[SLIDESG[SLIDETOP]] ← RUBOUT &
04500 (IF XCRIBL THEN (XTO&CVS(XF))
04600 ELSE ("+"&CVS(FILLIN)) );
04700 CHRS ← DEST ; SLIDETOP ← SLIDETOP - 1 ;
04800 BRKS ← 0 ; FSTCHRS ← CHRS ; FSTBRK ← SG ; COMMENT NOJUST TO LEFT ;
04900 FLUSHING ← FALSE ; FSIZE ← 0 ;
05000 END "RIGHTBOUND";
00100 IF PAGEHIGH THEN GO TO CONTINUE ; comment, re-entered ;
00200 AWHILE DO
00300 BEGIN "FILE"
00400 PAGEFILE ← INPUT(SEQCHAN, TO!ALTMODE!SKIP) ; IF SEQEOF THEN DONE ;
00500 IFC TENEX THENC
00600 IFILE ← IFILENAME & OCTEXT & PAGEFILE ;
00700 SFILE ← IFILENAME & TXTEXT & PAGEFILE ;
00800 ELSEC
00900 IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
01000 ENDC
01100 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ; SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
01200
01300 AWHILE DO
01400 BEGIN "PAGE"
01500 PAGEHIGH ← INNUM ; IF PAGEEOF ∨ PAGEHIGH≤0 THEN DONE ; PAGEWIDE ← INNUM ;
01600 IFC VERSION=PARCVER THENC LFTMAR ← 0 MAX (188*INNUM)/1000 - 94 ; TES 6/11/74 ADDED ;
01650 COMMENT 188 HORIZ BITS PER INCH, 94 BIT MIN MARGIN;
01700 ENDC
01710 IFC VERSION=CMUVER THENC LFTMAR ← 0 MAX (183*INNUM)/1000;
01720 Comment 183 bits per inch, user defaults his own zero margin; RKJ: 29-Aug-74;
01730 ENDC
01740 IFC VERSION=SAILVER OR VERSION=ITSVER THENC LFTMAR ← 0 MAX (200*INNUM)/1000;
01750 ENDC
02100 IF PAGEHIGH > IML ∨ PAGEWIDE > IMC THEN
02200 BEGIN "EXPAND"
02300 IF DEVICE=MIC THEN
02400 BEGIN "FRAME SIZE"
02500 IF LASL ≠ 1000 THEN OUT(LISTCHAN, ENDPAGE) ;
02600 NVERTI ← 11000 DIV PAGEHIGH MIN 16384 DIV PAGEWIDE MIN 375 ;
02700 NHORIZ ← 10*NVERTI DIV 11 ; NCSIZE ← (9*NHORIZ DIV 80)*8 ;
02800 OUT(LISTCHAN, SETSIZE(NCSIZE)&SETHORIZ(NHORIZ)&SETVERTI(NVERTI)) ;
02900 END "FRAME SIZE"
03000 IFC VERSION=SAILVER THENC
03100 ELSE IF DEVICE = LPT THEN
03200 BEGIN
03300 IF (LASL-1) MOD 66 + 1 ≤ 6 ∧ (PAGEHIGH-1) MOD 66 < 60 THEN
03400 OUT(LISTCHAN, ENDPAGE) ;
03500 ENDLINE ← IF PAGEHIGH≥54 THEN RUBOUT & '21 ELSE LF ;
03600 END ;
03700 ENDC;
03800 IML ← PAGEHIGH ; IMC ← PAGEWIDE ;
03900 DONE ; comment, Exit "SIZE" block and immediately reenter with bigger IMG array ;
04000 END "EXPAND" ;
04100
04200 CONTINUE: OUTSTR(SP & CVS(PAGECT ← PAGECT + 1)) ; AVAIL ← IML ;
04300 IFC VERSION=SAILVER THENC
04400 IF PAGECT > 1 THEN
04500 IF DEVICE = LPT THEN COMMENT AVOID SPURIOUS BLANK PAGE ;
04600 IF (IML-1) MOD 66 < 60 THEN OUT(LISTCHAN, ENDPAGE)
04700 ELSE FOR L ← (LASL-1) MOD 66 + 2 THRU 66 DO
04800 BEGIN OUT(LISTCHAN, CR) ; OUT(LISTCHAN, ENDLINE) END
04900 ELSE OUT(LISTCHAN, ENDPAGE) ;
05000 ENDC
05100 IFC VERSION=CMUVER THENC
05200 IF PAGECT>1 THEN OUT(LISTCHAN,ENDPAGE);
05300 ENDC
00100 WHILE (TOPLINE ← INNUM) > -10 DO
00200 BEGIN "AREA"
00300 NCOLS ← INNUM ; NLINES ← INNUM ;
00400 FOR COL ← 1 THRU NCOLS DO
00500 BEGIN "COLUMN"
00600 LEFTCH ← INNUM ;
00700 TLFTMAR ← LFTMAR + CHARW*(LEFTCH-1) ; TVR: Initiallize left margin for this column ;
00800 WHILE (LINENO ← INNUM) DO
00900 BEGIN "LINE"
01000 SH ← SHORTM ← INNUM ; SG ← FSTBRK ← -1 ; BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ;
01100 LINE ← TOPLINE - 1 + LINENO ;
01200 IF LINE<1∨LINE>IML THEN BEGIN WARN("Area outside page"); LINE←LINE MAX 1 MIN IML END ;
01300 L ← INNUM ; F ← L MOD FIML ; OWL ← OWLS[F] ;
01400 IF FULSTR(OWL) THEN BEGIN FROMFILE ← FALSE ; OWLS[F] ← NULL END
01500 ELSE BEGIN FROMFILE ← TRUE ;
01600 WHILE L ≠ (M←CVD(INP(TO!ALTMODE!SKIP))) DO
01700 BEGIN S ← NULL ;
01800 RKJ: 4-26-74, added EOF stuff on next two lines ;
01900 DO S ← S & INP(TO!LF!APPD) UNTIL PAGEBRC = LF OR PAGEEOF ;
02000 IF PAGEEOF THEN USERERR(0,0,"Bad input from Pass One, I give up.");
02100 OWLS[M MOD FIML] ← S ;
02200 END ;
02300 END ;
02400 IF ¬DEBUG THEN S ← SCN(TO!ALTMODE!SKIP)
02500 ELSE BEGIN
02600 SRCREF[LINE] ← SRCREF[LINE] & " " & SCN(TO!RUB!ALT!SKIP) ;
02700 WHILE PAGEBRC ≠ ALTMODE DO
02800 BEGIN "ERROR MESSG"
02900 S ← SCN(TO!RUB!ALT!SKIP) ; M ← LENGTH(S)+3 ; L ← LINE ;
03000 IF DEVICE=TTY ∨ (IMC MAX 75)+13*(NCOLS-COL)+LENGTH(SRCREF[L])+M ≤ 119 THEN
03100 SRCREF[L] ← SRCREF[L] & "..." & S ;
03200 END "ERROR MESSG" ;
03300 END ;
03400 DO BEGIN "PIECE"
03500 CHRS ← CHRS + LENGTH(SEG[SG ← SG + 1] ← SCN(BREAKER)) ;
00100 CASE CHARTBL[PAGEBRC] OF
00200 BEGIN comment by BRC ;
00300
00400 comment 0 ... ; IMPOSSIBLE("BREAKER") ;
00500
00600 comment 1 ... RUBOUT -- Font change ; BEGIN
00700 SEG[SG←SG+1] ← RUBOUT & (F←SCN(ONE!CHAR)) &
00800 (S ← IF F="-" ∨ F="+" ∨ F="=" THEN SCN(TO!ALTMODE!SKIP)
00900 ELSE IF F = "F" THEN SCN(ONE!CHAR)
01000 ELSE IF F="π" THEN SCNBYCOUNT(SCN(ONE!CHAR))
01100 ELSE NULL) ;
01200 IF F = "π" THEN CHRS ← CHRS + 1
01300 ELSE IF F = "+" THEN CHRS ← CHRS + CVD(S)
01400 ELSE IF F = "-" THEN CHRS ← CHRS - CVD(S)
01500 ELSE IF F = "→" THEN
01600 BEGIN COMMENT ∞ ;
01700 IF (SLIDETOP ← SLIDETOP + 1) > 5 THEN IMPOSSIBLE("SLIDETOP") ;
01800 SLIDESG[SLIDETOP] ← SG ; RB[SLIDETOP] ← SCNUM ;
01900 LBD[SLIDETOP] ← SCNUM ;
02000 IF XCRIBL THEN
02100 BEGIN
02200 RKJ; XFILL[SLIDETOP] ← SCNUM ;
02300 TES ; XINF[SLIDETOP] ← SCNUM ;
02400 END ;
02500 LBF[SLIDETOP] ← SCN(TO!ALTMODE!SKIP) ;
02600 IF XCRIBL AND FULSTR(LBF[SLIDETOP]) THEN SG←SG+1 ; RKJ: 1-9-74;
02700 FLUSHING ← TRUE;
02800 END
02900 ELSE IF F = "←" THEN
03000 RIGHTBOUND
03100 ELSE IF F = "=" THEN BEGIN
03200 comment 8/9/73 RKJ IF XCRIBL THEN SHORTM←(SHORTM-BRKS*CHARW) MAX 0;
03300 BRKS←0 ; FSTCHRS←CHRS←CVD(S) ; FSTBRK←SG END ;
03400 END ; COMMENT NOJUST LEFT OF TAB ;
03500
03600 comment 2 ... ALTMODE -- Word Break ; BEGIN BRKS ← BRKS + 1 ; SEG[SG←SG+1] ← ALTMODE END ;
03700
03800 comment 3 ... VT -- label reference ;
03900 BEGIN "LABEL REF"
04000 STRING S;
04100 S ← LABTAB[(F←SCNUM) LSH -14, F LAND '37777] ;
04200 L ← LENGTH(SEG[SG←SG+1] ← SCAN(S, TO!ALTMODE!SKIP, DUMMY)) ;
04300 J ← CVD(S) ;
04400 SHORTM ← SHORTM - (IF XCRIBL THEN J ELSE L) ; CHRS ← CHRS + L ;
04500 IF FLUSHING AND XCRIBL THEN FSIZE←FSIZE+J ;
04600 END "LABEL REF" ;
00100 comment 4 ... CR -- Justify it ;
00200 BEGIN "JUSTIFY"
00300 WHILE SLIDETOP DO BEGIN IMPOSSIBLE("SLIDE TOP") ; RIGHTBOUND END ;
00400 IF SHORTM < 0 THEN SHORTM ← 0 ;
00500 IF DEVICE = MIC THEN SHORTM ← SHORTM*NHORIZ
00600 ELSE BEGIN "DISTRIBUTE SPACES"
00700 COMMENT beta(α,K) = [α(K+1)] - [αK], PJ 5/27/74 ITS doesn't like <control-C>'s
00800 WHERE α = SHORTM/BRKS, is h.m. spaces to insert at the K'th break ;
00900 RATIO ← IF BRKS=0 THEN 0.0 ELSE SHORTM/BRKS ; TERM ← RATIO + .0001 ; BRKS ← 1 ;
01000 END "DISTRIBUTE SPACES" ;
01100 UNDERLINE←-1 ; LINE←TOPLINE-1+LINENO MAX 1 MIN IML ; CHAR←LEFTCH-1 MAX 0 ;
01200 NOTFST ← FALSE ; CHRS ← CHRS + CHAR ;
01300
01400 TVR: Initial column select for XGP ;
01600 IF XCRIBL AND (LEFTCH NEQ 1 OR LFTMAR > 0) THEN XGPTAB(0) ELSE
02000
02100 IF DEVICE = MIC AND FSTBRK = -1 THEN CHANGESPACING ;
02200 FOR G ← 0 THRU SG DO IF FULSTR(S ← SEG[G]) THEN CASE CHARTBL[S] OF
02300 BEGIN comment three cases ;
02400
02500 comment 0 ... text ;
02600 BEGIN "TEXT SEG"
02700 IF UNDERLINE<0 OR BAR=0 TES 10/22/73 ; THEN CHAR←APPD(S) ELSE
02800 IF DEVICE = MIC THEN
02900 BEGIN K ← LENGTH(S) ;
03000 WHILE K DO
03100 BEGIN COMMENT DON'T UNDERLINE BLANKS ;
03200 N ← LOP(S) ;
03300 IF N=SP THEN BEGIN UNDERSCORE(CHAR-K) ; UNDERLINE←UNDERLINE+1 END ;
03400 K ← K - 1 ;
03500 END ;
03600 END
03700 ELSE IF XCRIBL THEN
03800 BEGIN
03900 IFC VERSION=CMUVER THENC
04000 K←LENGTH(S); SS←0&SPS(K*4); N←LOP(SS);
04100 START!CODE "XGPUNDER"
04200 DEFINE LEN="2",SRC="3",DEST="4",RUB="5",ESC="6",R="7",CNT="'10",UBAR="'11";
04300 LABEL LOOP,ELOOP,SPACE,OUTT;
04400 SETZ CNT,0; MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI RUB,'177; MOVEI ESC,'35; MOVE UBAR,BAR;
04500 LOOP: ILDB R,SRC;
04600 CAIE R,BAR; CAIN R,SP; JRST SPACE;
04700 IDPB RUB,DEST; IDPB ESC,DEST; IDPB R,DEST; IDPB UBAR,DEST;
04800 ELOOP: SOJG LEN,LOOP;
04900 MOVEM CNT,N; JRST OUTT;
05000 SPACE: IDPB R,DEST;
05100 AOJA CNT,ELOOP;
05200 OUTT:
05300 END "XGPUNDER";
05400 CHAR←APPD(SS[1 TO (K*4-N*3)])-(K-N)*3;
05500 LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*3;
05600 ENDC
05700 IFC VERSION=SAILVER OR VERSION=ITSVER PJ 5/28/74 ; THENC CHAR←APPD(S); ENDC
05800 IFC VERSION=PARCVER THENC
05900 K←LENGTH(S); SS←0&SPS(K*3); N←LOP(SS);
06000 START!CODE "XGPUNDER"
06100 DEFINE LEN="2",SRC="3",DEST="4",BS="5",UBAR="6",CNT="7",R="'10";
06200 LABEL LOOP, OUTT, NOBAR; TES 8/19/74 TES CHAR BS BAR -> BAR BS CHAR, FOR BOBROW ;
06300 SETZ CNT,0;
06400 MOVE LEN,K; MOVE SRC,S; MOVE DEST,SS; MOVEI BS,'10; MOVE UBAR,BAR;
06500 LOOP: SOJL LEN,OUTT;
06600 ILDB R,SRC;
06800 CAIE R,BAR; CAIN R,SP; AOJA CNT,NOBAR;
06900 IDPB UBAR,DEST; IDPB BS,DEST;
06950 NOBAR: IDPB R,DEST;
07000 JUMPA LOOP;
07100 OUTT: MOVEM CNT,N;
07200 END "XGPUNDER";
07300 CHAR←APPD(SS[1 TO (K*3-N*2)])-(K-N)*2;
07400 LASC[L]←CHAR; FAKE[L]←FAKE[L]+(K-N)*2;
07500 ENDC
07600 END
00100 ELSE BEGIN CHAR ← APPD(S);
00200 K ← LENGTH(S) ; SS ← 0&S ; N ← LOP(SS) ; CHAR←CHAR-K ;
00300 IFC VERSION ≠ CMUVER THENC RKJ: 1-7-74;
00400 START!CODE "UNDER" LABEL LOOP ;
00500 MOVE 2, K ; MOVE 3, SS ;
00600 LOOP: ILDB 4,3 ; CAIE 4,SP ; CAIN 4,BAR ; CAIA 0,0 ; MOVE 4,BAR ; DPB 4,3 ; SOJG 2,LOOP ;
00700 END "UNDER" ; CHAR ← APPD(SS[1 TO LENGTH(S)]) ;
00800 ELSEC CHAR←APPD(S); ENDC RKJ: 1-7-74;
00900 END ;
01000 END "TEXT SEG" ;
01100
01200 comment 1 ... RUBOUT -- Font Change ;
01300 IF (F←S[2 FOR 1])="↑" THEN
01400 IF DEVICE=MIC THEN CTRL(DOUDOTS(CCSIZE MIN 63)) ELSE
01500 IFC VERSION=PARCVER THENC
01600 IF XCRIBL THEN
01700 IF (SCRLVL←SCRLVL+SCRIPT)≤0 THEN CTRL("R"-'100) ELSE
01800 BEGIN LABEL L1;
01900 CTRL("U"-'100);
02000 L1:
02100 IF G<SG THEN
02200 BEGIN
02300 SS←SEG[G+1];
02400 IF NULSTR(SS) THEN BEGIN G←G+1; GO L1 END; comment try again ;
02500 IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
02600 BEGIN
02700 G←G+1;
02800 CTRL(SS[3 FOR 1]);
02900 END ELSE CTRL(THISFONT);
03000 END ELSE CTRL(THISFONT)
03100 END
03200 ELSE ENDC
03300 IFC VERSION=SAILVER OR VERSION=ITSVER PJ 5/28/74 ; THENC
03400 IF XCRIBL THEN
03500 CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL+SCRIPT))
03600 ELSE ENDC LINE←LINE-1 MAX 1
03700 ELSE IF F = "↓" THEN
03800 IF DEVICE=MIC THEN CTRL(DOUDOTS(-(CCSIZE MIN 63))) ELSE
03900 IFC VERSION=PARCVER THENC
04000 IF XCRIBL THEN
04100 IF (SCRLVL←SCRLVL-SCRIPT)≥0 THEN CTRL("R"-'100) ELSE
04200 BEGIN LABEL L2;
04300 CTRL("S"-'100);
04400 L2:
04500 IF G<SG THEN
04600 BEGIN
04700 SS←SEG[G+1];
04800 IF NULSTR(SS) THEN BEGIN G←G+1; GO L2 END; comment ↑↑↑ ;
04900 IF EQU(SS[1 FOR 2],RUBOUT&"F") THEN
05000 BEGIN
05100 G←G+1;
05200 CTRL(SS[3 FOR 1]);
05300 END ELSE CTRL(THISFONT);
05400 END ELSE CTRL(THISFONT)
05500 END
05600 ELSE ENDC
05700 IFC VERSION=SAILVER OR VERSION=ITSVER PJ 5/28/74 ; THENC
05800 IF XCRIBL THEN
05900 CTRL(ESCAPE1&'43&(SCRLVL←SCRLVL-SCRIPT)) ELSE ENDC LINE←LINE+1 MIN IML
06000 ELSE IF F = "_" THEN
06100 BEGIN
06200 UNDERLINE ← CHAR;
06300 IFC VERSION=SAILVER THENC
06400 IF XCRIBL THEN CTRL(ESCAPE1&'46);
06405 ENDC
06410 IFC VERSION=ITSVER PJ 8/23/74 ; THENC
06420 IF XCRIBL THEN BEGIN CTRL(ESCAPE1&'46); CTRL(ESCAPE1&'46) END;
06430 ENDC
06600 END
06700 ELSE IF F = "≡" THEN
06800 BEGIN "END UNDERLINED TEXT"
06900 IF DEVICE = MIC AND BAR TES 10/22/73; THEN UNDERSCORE(CHAR) ;
07000 UNDERLINE ← -1 ;
07100 IFC VERSION=SAILVER THENC
07200 IF XCRIBL AND BAR TES 10/22/73; THEN
07300 CTRL(ESCAPE1&'47&3); TES AND REG 11/19/73 ;
07400 ENDC
07410 IFC VERSION=ITSVER THENC PJ 8/23/74 ;
07420 IF XCRIBL AND BAR THEN BEGIN CTRL(ESCAPE1&'47&3); CTRL(ESCAPE1&'47&4) END;
07430 ENDC
07500 END "END UNDERLINED TEXT"
07600 ELSE IF F="-" THEN
07700 IF DEVICE=MIC THEN CTRL(DOLSPCS(CVD(S[3 TO ∞])))
07800 ELSE CHAR←CHAR-CVD(S[3 TO ∞]) MAX 0
07900 ELSE IF F="*" THEN CHAR ← LASC[LINE] comment not always correct! ;
08000 ELSE IF F="+" THEN
08100 IF DEVICE=MIC THEN CTRL(DORSPCS(CVD(S[3 TO ∞])))
08200 ELSE IF XCRIBL THEN CTRL(VARBLANK(CVD(S[3 TO ∞])))
08300 ELSE CHAR←CHAR+CVD(S[3 TO ∞]) MIN IMC
08400 ELSE IF F="=" THEN
08500 BEGIN "TAB"
08600 F ← CVD(S[3 TO ∞]) ;
08700 IF NOT XCRIBL THEN F ← (F MAX 0) + LEFTCH - 1 MIN IMC ; TES 8/17/74 FIX BUG ;
08800 IF XCRIBL THEN XGPTAB(F)
08900 ELSE IF DEVICE ≠ MIC THEN CHAR ← F
09000 ELSE IF F < CHAR THEN DOLSPCS(CHAR - F)
09100 ELSE IF F > CHAR THEN DORSPCS(F - CHAR) ;
09200 END "TAB"
09300 ELSE IF F = "π" THEN
09400 BEGIN TES 11/29/73 REWROTE ;
11000 IFC VERSION=CMUVER THENC
11100 IF UNDERLINE GEQ 0 AND BAR THEN CTRL(RUBOUT&'35) ;
11200 ENDC TES 12/13/73 ;
11300 SS ← UNMASH(S[3 TO ∞]) ;
11400 IFC VERSION=PARCVER THENC SS←CTLQ&SS ; ENDC
11500 F ← LENGTH(SS)-1 ; CHAR ← APPD(SS)-F ;
11600 LASC[L] ← CHAR ; FAKE[L] ← FAKE[L] + F ;
11800 IF UNDERLINE≥0 AND BAR ∧ DEVICE≠MIC
11900 IFC VERSION=SAILVER OR VERSION=ITSVER PJ 5/28/74 ; THENC AND NOT XCRIBL ENDC
12000 THEN CTRL(IFC VERSION=PARCVER THENC '10& ENDC BAR) ; TES 12/13/73;
12100 END
12200 ELSE IF F = "←" THEN BEGIN END
00100 ELSE IF F="F" THEN FONTSELECT(S[3 FOR 1])
00200 ELSE IF F='35 THEN COMMENT OVERSTRIKE NEXT CHAR OVER LAST ;
00300 BEGIN "OVERSTRIKE"
00400 IFC VERSION=CMUVER THENC
00500 INTEGER Q;
00600 Q←IMG[L][(LASC[L]+FAKE[L]) FOR 1];
00700 LASC[L]←LASC[L]-1; CHAR←CHAR-1;
00800 CTRL(RUBOUT&'35); CHAR←APPD(Q);
00900 ENDC
01000 IFC VERSION=SAILVER OR VERSION=ITSVER PJ 5/28/74 ; THENC IMPOSSIBLE("Overstrike") ENDC
01100 IFC VERSION=PARCVER THENC
01200 CTRL('10)
01300 ENDC
01400 END
01500 ELSE IF F=RUBOUT THEN IF NOT XCRIBL THEN CHAR←APPD(SP) ELSE
01600 BEGIN
01700 CHAR←APPD(RUBOUT&RUBOUT)-1; LASC[L]←CHAR; FAKE[L]←FAKE[L]+1;
01800 END
01900 ELSE IMPOSSIBLE("FONT `"&F&"'") ;
02000
02100 comment 2 ... ALTMODE -- word break ;
02200 IF SHORTM ∧ G > FSTBRK THEN
02300 IF DEVICE ≠ MIC THEN
02400 BEGIN "SPREAD"
02500 TERMX ← RATIO*(BRKS←BRKS+1) + .0001 ;
02600 IF XCRIBL THEN
02700 BEGIN "DOVSB"
02800 CTRL(VARBLANK((TERMX-TERM) MIN SHORTM));
02900 SHORTM←(SHORTM-TERMX+TERM) MAX 0;
03000 END "DOVSB"
03100 ELSE CHAR ← CHAR + TERMX - TERM MIN IMC ;
03200 TERM ← TERMX ;
03300 END "SPREAD"
03400 ELSE CHANGESPACING
03500 TES 1/7/74 CHANGED... ELSE IF SHORTM AND XCRIBL THEN ... TO: ;
03600 ELSE IF XCRIBL THEN
03700 BEGIN
03800 CHAR←APPD(SP);
03900 END;
04000
04100 comment 3-5 ; IMPOSSIBLE("VT in SEG[]") ; IMPOSSIBLE("CR in SEG[]") ; IMPOSSIBLE("LF in SEG[]") ;
04200 END ; COMMENT three cases ;
04300 IF CHORIZ ≠ NHORIZ THEN CTRL(SETHORIZ(NHORIZ)) ;
04400 IFC VERSION=SAILVER OR VERSION=ITSVER PJ 5/28/74 ; THENC
04500 IF XCRIBL AND UNDERLINE≥0 THEN
04600 CTRL(ESCAPE1&'47&BASELINE);
04700 ENDC
04800 BRKS ← CHRS ← FSTCHRS ← SLIDETOP ← 0 ; SG ← FSTBRK ← -1 ; SHORTM ← SH ;
04900 END "JUSTIFY" ;
00100 comment 5 ... LF ; BEGIN END ;
00200 END ; comment, by BRC ;
00300 END "PIECE"
00400 UNTIL PAGEBRC = LF ;
00500 END "LINE" ;
00600 END "COLUMN" ;
00700 END "AREA" ;
00800
00900 FOR LASL ← PAGEHIGH DOWN 1 DO IF LASC[LASL] THEN DONE ;
01000
01100 F ← 120 - (IMC MAX 78) ;
01200 FOR N ← 1 THRU LASL DO
01300 BEGIN "LIST LINE"
01400 L ← N ; IF DEBUG ∧ LENGTH(S←SRCREF[L])>F ∧ DEVICE=LPT THEN S←S[1 TO F] ;
01500 NEEDCR ← FALSE ; TES 11/1/73 ;
01600 DO BEGIN "PART LINE"
01700 IF M ← LASC[L] THEN
01800 BEGIN "NONBLANK"
01900 IF NEEDCR THEN OUT(LISTCHAN, RESTARTLINE) ELSE NEEDCR ← TRUE ; TES 11/1/73;
02000 OUT(LISTCHAN, FIXUP(IMG[L][1 TO M+FAKE[L]])) ;
02100 IF DEBUG ∧ L=N THEN OUT(LISTCHAN,
02200 (IF XCRIBL THEN XTABSTR(LFTMAR+IMC*CHARW+1) ELSE SPS((IMC MAX 80)-M)) RKJ: 1-4-74;
02300 & S);
02400 END "NONBLANK" ;
02500 M ← L ; L ← LINK[M] ; LINK[M] ← LASC[M] ← FAKE[M] ← 0 ;
02600 END "PART LINE" UNTIL L=0 ;
02700 TES 11/1/73 CHANGED ; OUT(LISTCHAN, CR) ; COMMENT ALWAYS CR BEFORE LF ;
02800 OUT(LISTCHAN, ENDLINE) ;
02900 IF DEBUG THEN SRCREF[N] ← NULL ;
03000 END "LIST LINE" ;
03100
03200 FOR N ← LASL+1 THRU PAGEHIGH DO FAKE[N]←LINK[N]←0 ; TES 4/4/74 ;
03300
03400 IFC VERSION=PARCVER OR VERSION=ITSVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC
03500
03600 END "PAGE" ;
03700
03800 IF ¬(PAGEEOF ∨ PAGEHIGH≤0) THEN DONE ; comment expand IMG ;
03900 RELEASE(ICHAN) ; RELEASE(SCHAN) ;
04000 END "FILE" ;
04100
04200 END "SIZE" UNTIL SEQEOF ;
04300
04400 IFC VERSION=SAILVER THENC OUT(LISTCHAN, ENDPAGE) ; ENDC
04500
04600 RELEASE(LISTCHAN) ; RELEASE(SEQCHAN) ;
04700 END "INNER BLOCK" ;
00100 BEGIN EXTERNAL SIMPLE PROCEDURE K!OUT ; K!OUT END ; COMMENT ** ** ** ** ** ;
00200
00300 OUTSTR("." & CRLF) ; comment signal terminal that pass two is done ;
00400 IF DELINT="A" ∨ DELINT="a" THEN
00500 BEGIN
00600 OUTSTR(CRLF & "DELETE INTERMEDIATE FILES?(Y OR N,CR)") ;
00700 DELINT ← INCHWL ;
00800 END ;
00900 IF DELINT="Y" ∨ DELINT="y" THEN
01000 BEGIN "DELETE INTERMEDIATE FILES"
01100 IFC TENEX THENC
01200 SIMPLE PROCEDURE DELVER(STRING FINAME) ;
01300 BEGIN INTEGER CHN ;
01400 CHN ← OPENFILE(FINAME&";*", "RO*") ;
01500 DO DELF(CHN) UNTIL NOT INDEXFILE(CHN) ;
01600 RELEASE(CHN) ;
01700 END ;
01800 DELVER(JOBNO & ".PASS2") ;
01900 ENDC
02000 SEQCHAN ← READIN(
02100 IFC TENEX THENC IFILENAME&".FILES" ELSEC "PUPSEQ"&PUIEXT ENDC,
02200 FALSE, SEQBRC, SEQEOF) ;
02300 DO INPUT(SEQCHAN, TO!LF!APPD) UNTIL SEQBRC=LF;
02400 IFC TENEX THENC DELVER(IFILENAME & ".LABELS") ; ELSEC
02500 LABCHAN ← READIN("PULABL"&PUIEXT, FALSE, LABBRC, LABEOF) ;
02600 RENAME(LABCHAN, NULL, 0, I) ;
02700 RELEASE(LABCHAN);
02800 ENDC
02900 AWHILE DO
03000 BEGIN
03100 PAGEFILE ← INPUT(SEQCHAN, TO!ALTMODE!SKIP) ;
03200 IF SEQEOF THEN DONE ;
03300 IFC TENEX THENC
03400 DELVER(IFILENAME & OCTEXT & PAGEFILE) ;
03500 DELVER(IFILENAME & TXTEXT & PAGEFILE) ;
03600 ELSEC
03700 IFILE ← PAGEFILE & PUIEXT ; SFILE ← PAGEFILE & "S"&PUIEXT ;
03800 ICHAN ← READIN(IFILE, TRUE, PAGEBRC, PAGEEOF) ;
03900 SCHAN ← READIN(SFILE, FALSE, PAGEBRC, PAGEEOF) ;
04000 RENAME(ICHAN, NULL, 0, I) ; RENAME(SCHAN, NULL, 0, I) ;
04100 RELEASE(ICHAN); RELEASE(SCHAN);
04200 ENDC
04300 END ;
04400 IFC NOT TENEX THENC RENAME(SEQCHAN, NULL, 0, I) ENDC ;
04500 RELEASE(SEQCHAN) ;
04600 IFC TENEX THENC DELVER(IFILENAME & ".FILES") ; ENDC
04700 END "DELETE INTERMEDIATE FILES"
04800 ELSE IF DELINT≠"N" ∧ DELINT≠"n" THEN
04900 WARN(DELINT&"? -- INTERMEDIATE FILES WERE NOT DELETED") ;
05000
05100 IFC VERSION=SAILVER THENC
05200 IF DEVICE = MIC THEN
05300 BEGIN "PASS 3"
05400 INTEGER FCHAN ;
05500 INTEGER SIMPLE PROCEDURE CORELOC(INTEGER ARRAY A) ; START!CODE MOVE 1, A ; END ;
05600 INTEGER ARRAY PASSTHREE[0:4] ;
05700 FCHAN ← WRITEON("$PUB$"&RPGEXT) ;
05800 OUT(FCHAN, LISTFILE&CRLF&TMPFILE&CRLF&"F"&CRLF&FF) ;
05900 RELEASE(FCHAN) ;
06000 PASSTHREE[0] ← CVSIX("DSK") ;
06100 PASSTHREE[1] ← CVFIL("TXTF80[1,3]", PASSTHREE[2], PASSTHREE[4]) ;
06200 PASSTHREE[3] ← 1 ; COMMENT STARTING ADDRESS IS NORMAL + 1 ;
06300 OUTSTR("PRODUCING FR80 FILE" & CRLF) ;
06400 CALL(CORELOC(PASSTHREE), "SWAP") ;
06500 END "PASS 3" ;
06600 IF XCRIBL THEN LODED("XSPOOL "&LISTFILE&CRLF);
06700 ENDC
06800
06900 IFC VERSION=CMUVER THENC
07000 IF XCRIBL AND DOPASS3 RKJ: 1-4-74; THEN
07100 BEGIN "RUN DOXAP"
07200 INTEGER ARRAY RUNBLK[0:5];
07300 INTEGER C,D;
07400 INTEGER PROCEDURE PJOB;
07500 START!CODE CALLI 1, '30; END;
07600
07700 SETFORMAT(-3,0);
07800 C←WRITEON(CVS(PJOB)&"PB3.TMP");
07900 OUT(C,LISTFILE&CR&LF);
08000 RELEASE(C);
08100
08200 RUNBLK[0]←CVSIX("DSK");
08300 RUNBLK[1]←CVFIL("PUB3[A700PU00]",RUNBLK[2],RUNBLK[4]);
08400 RUNBLK[3]←RUNBLK[5]←0;
08500 START!CODE
08600 MOVE 1, RUNBLK;
08700 HRLI 1, 1;
08800 CALLI 1, '35;
08900 JRST 4, ;
09000 END;
09100 END "RUN DOXAP"
09200 else
09300 while true do
09400 begin "maybererun"
09500 comment
09600 This tests to see if the nnnPUB.TMP file
09700 still exists: if it does, there are more
09800 commands and we rerun PUB. Otherwise we
09900 are done. Each rerun removes one
10000 command from the file, so the procedure is
10100 guaranteed to terminate
10200 Added by Joe Newcomer 7 Apr 74.
10300 ;
10400 integer C,D,ZILCH;
10500 integer array RUNBLK[0:5];
10600 SETFORMAT(-3,0);
10700 D←1;
10800 C←GETCHAN;
10900 if C<0 then done "maybererun";
11000 OPEN(C,"DSK",0,1,0,50,ZILCH,D);
11100 if D then done "maybererun";
11200 LOOKUP(C,CVS(CALL(0,"PJOB"))&"PUB.TMP",D);
11300 if D then done "maybererun";
11400 RUNBLK[0]←CVSIX("SYS");
11500 RUNBLK[1]←CVSIX("PUB");
11600 RUNBLK[2]←RUNBLK[3]←RUNBLK[4]←RUNBLK[5]←0;
11700 start!code "runit"
11800 MOVE 1,RUNBLK;
11900 HRLI 1,1 ;
12000 CALLI 1,'35;
12100 JRST 4,;
12200 end "runit";
12300 end "maybererun";
12400 ENDC
12500
12600 IFC TENEX THENC CALL(1,"EXIT") ; CALL(0,"EXIT") ELSEC
12700 START!CODE IFC VERSION ≠ ITSVER THENC CALLI 1,'12; ENDC CALLI 0,'12; END;
12800 ENDC
12900
13000 END "PUB2" ;